home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 09 - 1993 / 09.02 Feb 93 / Jörg's Folder / FONT.patch.4th < prev    next >
Encoding:
Text File  |  1992-06-07  |  4.1 KB  |  188 lines  |  [TEXT/MACH]
  1. ONLY MAC
  2. ALSO ASSEMBLER
  3. ALSO FORTH DEFINITIONS
  4.  
  5. HEADER font.STR
  6.     DC.B    6
  7.     DC.B    'Monaco'
  8.  
  9. .ALIGN
  10. (
  11. : get.MONACO.handle    ( -- handle )
  12.     { | name.handle font.handle 
  13.         [ 12 LALLOT ] FMInput.rec FMOutput.rec -- handle }
  14.  
  15.     0 -> font.handle
  16.     $53545220 1024 CALL GetResource ( -- handle )
  17.     ?DUP 0= NOT
  18.     IF
  19.         ( -- handle )
  20.         -> name.handle
  21.         name.handle CALL HLock DROP
  22.         name.handle @  ^ FMInput.rec CALL GetFNum
  23.         name.handle CALL HUnLock DROP
  24.         name.handle CALL DisposHandle
  25.     ELSE
  26.         ( -- )
  27.         ['] font.STR ^ FMInput.rec CALL GetFNum
  28.     THEN
  29.  
  30.     ^ FMInput.rec W@ 0= NOT
  31.     IF
  32.         ^ FMInput.rec W@ 9 CALL RealFont
  33.         IF
  34.             9 ^ FMInput.rec 2+ W!
  35.             0 ^ FMInput.rec 4+ C!    \ plain style
  36.             -1 ^ FMInput.rec 5 + C!    \ need bits
  37.             0  ^ FMInput.rec 6 + W!    \ screen device
  38.             $10001  ^ FMInput.rec 8 + !
  39.             $10001  ^ FMInput.rec 12 + !
  40.             ^ FMInput.rec CALL FMSwapFont ( -- FMOutPtr )
  41.             DUP
  42.             W@ 0=
  43.             IF
  44.                 ( -- ptr )
  45.                 2+ @    ( -- handle )
  46.                 -> font.handle
  47.             ELSE
  48.                 DROP
  49.             THEN
  50.         THEN
  51.     THEN
  52.     font.handle
  53.     ;
  54. )
  55. CODE get.MONACO.handle ( -- handle )
  56.     LINK    A2,#-24
  57.     CLR.L    -8(A2)
  58.  
  59.     EXG.L    D4,A7
  60.     SUBQ.L    #4,A7                \ allocate space for handle
  61.     MOVE.L    #$53545220,-(A7)    \ 'STR '
  62.     MOVE.W    #$400,-(A7)            \ ID = 1024
  63.             _GetResource        \ get font name stored in resource fork
  64.     MOVE.L    (A7)+,-4(A2)
  65.     EXG.L    D4,A7
  66.     BEQ.S    @defaultfont        \ didn't get it, use name in code
  67.  
  68.     EXG.L    D4,A7
  69.     MOVE.L    -4(A2),A0            \ lock the string handle
  70.             _HLock
  71.     MOVE.L    (A0),-(A7)            \ get string pointer
  72.     PEA        -24(A2)                \ push VAR for font number
  73.             _GetFNum
  74.  
  75.     MOVE.L    -4(A2),A0            \ get handle
  76.             _HUnLock
  77.             _DisposHandle
  78.     EXG.L    D4,A7                \ restore FORTH stack
  79.     BRA.S    @testforFont
  80.  
  81. @defaultfont
  82.     EXG.L    D4,A7
  83.     PEA        font.STR            \ push default font name
  84.     PEA        -24(A2)                \ push VAR for font number
  85.             _GetFNum
  86.     EXG.L    D4,A7
  87.  
  88. @testforFont
  89.     TST.W    -24(A2)                \ test returned font number
  90.     BEQ.S    @wordexit            \ ID = 0 returns a NIL handle
  91.  
  92.     EXG.L    D4,A7
  93.     SUBQ.L    #2,A7                \ allocate Boolean 
  94.     MOVE.W    -24(A2),-(A7)        \ push family ID
  95.     MOVE.W    #9,-(A7)            \ push font size
  96.             _RealFont
  97.     MOVE.W    (A7)+,D0            \ examine boolean
  98.     EXG.L    D4,A7
  99.     BEQ.S    @wordexit            \ real font is not, return NIL handle
  100.  
  101.     MOVE.W    #9,-22(A2)            \ set font size in FMInput.rec
  102.     CLR.B    -20(A2)                \ style = plain
  103.     MOVE.B    #-1,-19(A2)            \ needBits = TRUE
  104.     CLR.W    -18(A2)                \ device = 0 (screen)
  105.     MOVE.L    #$10001,-16(A2)        \ scale factor of 1
  106.     MOVE.L    #$10001,-12(A2)        \ scale factor of 1
  107.  
  108.     EXG.L    D4,A7
  109.     SUBQ.L    #4,A7                \ allocate space for FMOutput ptr
  110.     PEA        -24(A2)                \ push FMInput record ptr
  111.             _FMSwapFont
  112.     MOVE.L    (A7)+,A0            \ get FMOutput ptr
  113.     EXG.L    D4,A7
  114.  
  115.     TST.W    (A0)                \ is error = 0
  116.     BNE.S    @wordexit
  117.  
  118.     MOVE.L    2(A0),-8(A2)        \ stash font record handle
  119.  
  120. @wordexit
  121.     MOVE.L    -8(A2),-(A6)
  122.     UNLK    A2
  123.     RTS
  124. END-CODE
  125.  
  126. .ALIGN
  127. HEADER get.MONACO.end
  128.  
  129. VARIABLE CODE14.handle
  130. VARIABLE res.refnum
  131. VARIABLE saved.refnum
  132.  
  133. " MACH2" CALL OpenResFile res.refnum !
  134. CALL CurResFile  saved.refnum !
  135. res.refnum @ CALL UseResFile
  136.  
  137. HEADER 'CODE'
  138.     DC.B    'CODE'
  139.  
  140. ' 'CODE' @ 14 CALL GetResource CODE14.handle !
  141.  
  142. CODE14.handle @ CALL GetResAttrs $E7 AND  ( clear locked and protected )
  143. CODE14.handle @ SWAP CALL SetResAttrs
  144.  
  145. VARIABLE old.CODE14.size
  146. VARIABLE new.CODE14.size
  147. VARIABLE CODE14.patch.size
  148.  
  149. CODE14.handle @ CALL SizeRsrc old.CODE14.size !
  150. CODE14.handle @ CALL DetachResource
  151.  
  152. ' get.MONACO.end  ' font.STR - DUP CODE14.patch.size !
  153. old.CODE14.size @ +    DUP new.CODE14.size ! ( add size of patch )
  154. CODE14.handle @ SWAP CALL SetHandleSize DROP
  155.  
  156. CODE14.handle @ CALL HLock DROP
  157.  
  158. ' font.STR 
  159. CODE14.handle @ @ old.CODE14.size @ +
  160. CODE14.patch.size @
  161. CMOVE                
  162. ( the new code is copied in, now patch the old code)
  163.  
  164. VARIABLE new.CODE14.ptr
  165.  
  166. CODE14.handle @ @ CALL StripAddress new.CODE14.ptr !
  167.  
  168. $4EBA new.CODE14.ptr @ $A0 + W!        \ JSR d(PC)
  169.  
  170. ' get.MONACO.handle ' font.STR -
  171. old.CODE14.size @ $A2 - +            \ now have new offset
  172. new.CODE14.ptr @ $A2 + W!
  173.  
  174. ( now put in bra.s for old.code )
  175. $601C new.CODE14.ptr @ $A4 + W!        \ BRA.S $+1C
  176.  
  177. ( patch is done, now update the program file )
  178.  
  179. ' 'CODE' @ 14 CALL GetResource DUP
  180. CALL RmveResource CALL DisposHandle DROP
  181. res.refnum @ CALL UpdateResfile
  182.  
  183. " DEBG" CONSTANT debug.str
  184.  
  185. CODE14.handle @ ' 'CODE' @ 14 debug.str CALL AddResource
  186. res.refnum @ CALL UpdateResFile
  187.  
  188. saved.refnum @ CALL UseResFile